home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / demos / MkSample.tcl.z / MkSample.tcl
Encoding:
Text File  |  1999-01-26  |  6.5 KB  |  270 lines
  1. # MkSample.tcl --
  2. #
  3. #    This file implements the "Sample" page in the widget demo
  4. #
  5. #    This file has not been properly documented. It is NOT intended
  6. #    to be used as an introductory demo program about Tix
  7. #    programming. For such demos, please see the files in the
  8. #    demos/samples directory or go to the "Samples" page in the
  9. #    "widget demo"
  10. #
  11. #
  12. # Copyright (c) 1996, Expert Interface Technologies
  13. #
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17. #
  18. #
  19.  
  20. set tix_demo_running 1
  21. set samples_dir [tixNSubFolder $demo_dir samples]
  22. set sample_filename {}
  23.  
  24. uplevel #0 source [list [tixNSubFolder $samples_dir AllSampl.tcl]]
  25.  
  26.  
  27. proc MkSample {nb page} {
  28.     global tixOption
  29.  
  30.     #----------------------------------------------------------------------
  31.     set w [$nb subwidget $page]
  32.  
  33.     set pane [tixPanedWindow $w.pane -orient horizontal]
  34.     pack $pane -expand yes -fill both
  35.  
  36.     set f1 [$pane add 1 -expand 1]
  37.     set f2 [$pane add 2 -expand 3]
  38.     $f1 config -relief flat
  39.     $f2 config -relief flat
  40.  
  41.     # Left pane: the Tree:
  42.     #
  43.     set lab [label $f1.lab  -text "Select a sample program:" -anchor w]
  44.     set tree [tixTree $f1.slb \
  45.     -options {
  46.         hlist.selectMode single
  47.         hlist.width  40
  48.     }]
  49.     $tree config \
  50.     -command   "Sample:Action $w $tree run" \
  51.     -browsecmd "Sample:Action $w $tree browse"
  52.  
  53.     pack $lab -side top -fill x -padx 5 -pady 5
  54.     pack $tree -side top -fill both -expand yes -padx 5
  55.  
  56.     # Right pane: the Text
  57.     #
  58.     set labe [tixLabelEntry $f2.lab -label "Source:" -options {
  59.     label.anchor w
  60.     }]
  61.  
  62.     $labe subwidget entry config -state disabled
  63.  
  64.     set stext [tixScrolledText $f2.stext]
  65.     set f3 [frame $f2.f3]
  66.  
  67.     set run  [button $f3.run  -text "Run ..."  \
  68.     -command "Sample:Action $w $tree run"]
  69.     set view [button $f3.view -text "View Source in Browser ..." \
  70.     -command "Sample:Action $w $tree view"]
  71.  
  72.     pack $run $view -side left -fill y -pady 2
  73.  
  74.     pack $labe -side top -fill x -padx 7 -pady 2
  75.     pack $f3 -side bottom -fill x -padx 7
  76.     pack $stext -side top -fill both -expand yes -padx 7
  77.  
  78.     #
  79.     # Set up the text subwidget
  80.  
  81.     set text [$stext subwidget text]
  82.     bind $text <1> "focus %W"
  83.     bind $text <Up>    "%W yview scroll -1 unit"
  84.     bind $text <Down>  "%W yview scroll 1 unit"
  85.     bind $text <Left>  "%W xview scroll -1 unit"
  86.     bind $text <Right> "%W xview scroll 1 unit"
  87.     bind $text <Tab>   {focus [tk_focusNext %W]; break}
  88.  
  89.     bindtags $text "$text Text [winfo toplevel $text] all"
  90.  
  91.     $text config -bg [$tree subwidget hlist cget -bg] \
  92.     -state disabled -font $tixOption(fixed_font) -wrap none
  93.  
  94.     $run  config -state disabled
  95.     $view config -state disabled
  96.  
  97.     global demo
  98.     set demo(w:run)  $run
  99.     set demo(w:view) $view
  100.     set demo(w:tree) $tree
  101.     set demo(w:lab1) $labe
  102.     set demo(w:stext) $stext
  103.  
  104.     set hlist [$tree subwidget hlist]
  105.     $hlist config -separator "." -width 30 -drawbranch 0 \
  106.     -wideselect false
  107.  
  108.     set style [tixDisplayStyle imagetext -refwindow $hlist \
  109.     -fg #202060 -padx 4]
  110.  
  111.     uplevel #0 set TRANSPARENT_GIF_COLOR [$hlist cget -bg]
  112.  
  113.     set file   [tix getimage textfile]
  114.     set folder [tix getimage openfold]
  115.  
  116.     ForAllSamples root "" \
  117.     [list AddSampleToHList $tree $hlist $style $file $folder]
  118. }
  119.  
  120. # AddSampleToHList --
  121. #
  122. #    A callback from ForAllSamples. Add all the possible sample files
  123. #    into the Tree widget.
  124. #
  125. proc AddSampleToHList {tree hlist style file folder token type text dest} {
  126.     case $type {
  127.     d {
  128.         return [$hlist addchild $token -itemtype imagetext -style $style \
  129.         -image $folder -text $text]
  130.     }
  131.     done {
  132.         if {![tixStrEq $token ""]} {
  133.         $tree setmode $token close
  134.         $tree close $token
  135.         }
  136.     }
  137.     f {
  138.         return [$hlist addchild $token -itemtype imagetext \
  139.         -image $file -text $text -data [list $text $dest]]
  140.     }
  141.     }
  142. }
  143.  
  144. proc Sample:Action {w slb action args} {
  145.     global samples demo_dir demo samples_dir
  146.  
  147.     set hlist [$slb subwidget hlist]
  148.     set ent [$hlist info anchor]
  149.  
  150.     if {$ent == ""} {
  151.     $demo(w:run)  config -state disabled
  152.     $demo(w:view) config -state disabled
  153.     return
  154.     }
  155.     if {[$hlist info data $ent] == {}} {
  156.     # This is just a comment
  157.     $demo(w:run)  config -state disabled
  158.     $demo(w:view) config -state disabled
  159.     return
  160.     } else {
  161.     $demo(w:run)  config -state normal
  162.     $demo(w:view) config -state normal
  163.     }
  164.  
  165.     set theSample [$hlist info data $ent]
  166.     set title [lindex $theSample 0]
  167.     set prog  [lindex $theSample 1]
  168.  
  169.     case $action {
  170.     "run" {
  171.         RunProg $title $prog
  172.     }
  173.     "view" {
  174.         LoadFile [tixNSubFolder $samples_dir $prog]
  175.     }
  176.     "browse" {
  177.         # Bring up a short description of the sample program
  178.         # in the scrolled text about
  179.  
  180.         set text [$demo(w:stext) subwidget text]
  181.         uplevel #0 set sample_filename [list [tixNSubFolder $samples_dir $prog]]
  182.         tixWidgetDoWhenIdle ReadFileWhenIdle $text
  183.  
  184.         $demo(w:lab1) subwidget entry config -state normal
  185.         $demo(w:lab1) subwidget entry delete 0 end
  186.         $demo(w:lab1) subwidget entry insert end [tixNSubFolder $samples_dir $prog]
  187.         $demo(w:lab1) subwidget entry xview end
  188.         $demo(w:lab1) subwidget entry config -state disabled
  189.     }
  190.     }
  191. }
  192.  
  193. proc RunProg {title prog} {
  194.     global samples demo_dir demo samples_dir
  195.  
  196.     set w .[lindex [split $prog .] 0]
  197.     set w [string tolower $w]
  198.  
  199.     if [winfo exists $w] {
  200.     wm deiconify $w
  201.     raise $w
  202.     return
  203.     }
  204.  
  205.     uplevel #0 source [list [tixNSubFolder $samples_dir $prog]]
  206.  
  207.     toplevel $w 
  208.     wm title $w $title
  209.     RunSample $w
  210. }
  211.  
  212.  
  213. proc LoadFile {filename} {
  214.     global tixOption
  215.  
  216.     set tmp $filename
  217.     regsub -all . $filename _ tmp
  218.     set w [string tolower .$tmp]
  219.  
  220.     if [winfo exists $w] {
  221.     wm deiconify $w
  222.     raise $w
  223.     return
  224.     }
  225.  
  226.     toplevel $w 
  227.     wm title $w "Source View: $filename"
  228.  
  229.     button $w.b -text Close -command "destroy $w"
  230.     set t [tixScrolledText $w.text]
  231.     tixForm $w.b    -left 0 -bottom -0 -padx 4 -pady 4
  232.     tixForm $w.text -left 0 -right -0 -top 0 -bottom $w.b
  233.  
  234.     $t subwidget text config -highlightcolor [$t cget -bg] -bd 2 \
  235.     -bg [$t cget -bg] -font $tixOption(fixed_font) 
  236.     if {$filename == {}} {
  237.     return
  238.     }
  239.  
  240.     set text [$w.text subwidget text]
  241.     $text config -wrap none
  242.  
  243.     ReadFile $text $filename
  244. }
  245.  
  246. proc ReadFileWhenIdle {text} {
  247.     global sample_filename
  248.  
  249.     if ![file isdir $sample_filename] {
  250.     ReadFile $text $sample_filename
  251.     }
  252. }
  253.  
  254. proc ReadFile {text filename} {
  255.     set oldState [$text cget -state]
  256.     $text config -state normal
  257.     $text delete 0.0 end
  258.  
  259.     set fd [open $filename {RDONLY}]
  260.     $text delete 1.0 end
  261.     
  262.     while {![eof $fd]} {
  263.         $text insert end [gets $fd]\n
  264.     }
  265.     close $fd
  266.  
  267.     $text see 1.0
  268.     $text config -state $oldState
  269. }
  270.